home *** CD-ROM | disk | FTP | other *** search
/ PD ROM 1 / PD ROM Volume I - Macintosh Software from BMUG (1988).iso / Programming / Programming Tools / FORTRAN Routines / SAFE2SOL.FOR < prev    next >
Encoding:
Text File  |  1986-07-17  |  54.1 KB  |  1,403 lines  |  [TEXT/ttxt]
  1. $LINESIZE: 132
  2. $PAGESIZE: 61
  3. $STORAGE: 2
  4. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  5. C                                                                      C
  6. C                          M I C R O S A F E                           C
  7. C                Structural Analysis by Finite Elements                C
  8. C                     Module : SAFESOLV,  1st Part                     C
  9. C                            Version : 2-D                             C
  10. C                                                                      C
  11. C         COPYRIGHT (C) by MICROSTRESS Corporation - 1985,1986         C
  12. C                         ALL RIGHTS RESERVED                          C
  13. C                                                                      C
  14. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  15.       PROGRAM safesolv
  16. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  17. C                                                                      C
  18. C                          TYPE SPECIFICATION                          C
  19. C                                                                      C
  20. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  21.       INTEGER ppmuqq,ofnflg,echflg,scrflg,ascstr,longi*4,longj*4,
  22.      +        longk*4,longl*4,ddrive,odrive,previd,memava*4,numele*4
  23.       DOUBLE PRECISION invqcn,stmtrx,stmqcn,disdof,beamcf,ftcons,pthick,
  24.      +                 eyoung,pratio,diffnc,blngth,bmlcos,bmlsin,appldf,
  25.      +                 ratio,sttemp,th
  26.       CHARACTER inpfil*78,outfil*78,toufil*78,txtdisp*24,comand*127,
  27.      +          space*2,string*5,datext*11,timtxt*12,intgst*25,dash*1,
  28.      +          prompt*56,diamsg*110,reaclb*8,arrow*1,elipss*4,
  29.      +          blank*1,ifdriv*6,ifpath*64,ifname*9,ifextn*5,flspec*78,
  30.      +          ofdriv*6,ofpath*64,ofname*9,ofextn*5,toextn*5
  31.       LOGICAL ffound
  32. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  33. C                                                                      C
  34. C                          ARRAY DIMENSIONING                          C
  35. C                                                                      C
  36. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  37.       DIMENSION invqcn(2,2),ftcons(9),diffnc(2,4),txtdisp(3),plints(3),
  38.      +          baxial(600),bshear(2,600),bmomnt(2,600),inp(3),entry(8),
  39.      +          sttemp(8,2),reaclb(3),youngm(20),poisson(20),
  40.      +          lenhbw(1200),nodst3(400),igndof(1200),beamcf(3,3),
  41.      +          mxndif(400),nodebm(2,600),bmarea(600),bminer(600),
  42.      +          matcbm(600),bmdis1(600),bmdis2(600),plteth(500),
  43.      +          matcpl(500),nodefs(2,60),fsarea(60),fsstif(60),
  44.      +          nodepl(4,500)
  45. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  46. C                                                                      C
  47. C                         COMMON SPECIFICATION                         C
  48. C                                                                      C
  49. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  50.       COMMON /global/ numdof,stmqcn(2,2)
  51.       common /sizebw/ malhbw
  52.       COMMON /plates/ disdof(1203),pltecf(2,4),plstrs(3,500),
  53.      +                reafor(3,400),pstnor(3,400),pstacc(3,400)
  54.       COMMON /aaaaaa/ stmtrx(8200)
  55.       common /filenm/ inpfil,outfil
  56.       common /forces/ appldf(1200)
  57.       COMMON /dskrom/ scrflg,odrive
  58.       common /coordi/ coonod(2,401)
  59. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  60. C                                                                      C
  61. C                        USER DEFINED FUNCTIONS                        C
  62. C                                                                      C
  63. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  64.       previd(k,l)=MOD(k+l-2,l)+1
  65.       nextid(k,l)=MOD(k,l)+1
  66. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  67. C                                                                      C
  68. C                        GENERAL INITIALIZATION                        C
  69. C                                                                      C
  70. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  71.       call time (inithr,initmn,initsc,iniths)
  72.       call datstr (datext)
  73.       call timstr (timtxt)
  74. C
  75. C  Show copyright notice on the screen.
  76. C
  77.       call logpsl
  78. C
  79. C  Initialize variables.
  80. C
  81.       scrflg=0
  82.       maxban=6
  83.       stmqcn(1,1)=0.
  84.       stmqcn(1,2)=0.
  85.       stmqcn(2,1)=0.
  86.       stmqcn(2,2)=0.
  87.       space='  '
  88.       call setstr (2,space)
  89.       toextn='.OUT '
  90.       call setstr (5,toextn)
  91.       elipss='... '
  92.       call setstr (4,elipss)
  93.       call defdrv (0,ddrive)
  94. C
  95. C  Determine number of stiffness matrix elements which will fit in RAM.
  96. C
  97.       numele=memava(stmtrx(1))/4
  98.       if (numele .gt. 65535) numele=65535
  99. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  100. C                                                                      C
  101. C                         READ THE COMMAND TAIL                        C
  102. C                                                                      C
  103. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  104.       ierror=ppmuqq (0,0,comand)
  105.       length=ascstr (1,comand)+2
  106.       if (length .ne. 2) then
  107.           call setstr (127,comand)
  108.           call endstr (length,comand)
  109.           call movstr (comand,1,0,space,1,1)
  110.           call upcstr (comand)
  111.           string=' I=  '
  112.           call setstr (4,string)
  113.           locatn=locstr (1,comand,string)+3
  114.           if (locatn .ne. 3) then
  115.               nxtloc=locstr (locatn,comand,space)
  116.               if (nxtloc .eq. 0) nxtloc=length
  117.               numchr=nxtloc-locatn
  118.               inpfil='
  119.      +                            '
  120.               call setstr (78,inpfil)
  121.               call movstr (inpfil,1,0,comand,locatn,numchr)
  122.               call resstr (inpfil)
  123.               ifnflg=1
  124.           endif
  125.           call modstr (string,2,79)
  126.           locatn=locstr (1,comand,string)+3
  127.           if (locatn .ne. 3) then
  128.               nxtloc=locstr (locatn,comand,space)
  129.               if (nxtloc .eq. 0) nxtloc=length
  130.               numchr=nxtloc-locatn
  131.               outfil='
  132.      +                            '
  133.               call setstr (78,outfil)
  134.               call movstr (outfil,1,0,comand,locatn,numchr)
  135.               call resstr (outfil)
  136.               ofnflg=1
  137.           endif
  138.           string=' E   '
  139.           call setstr (3,string)
  140.           locatn=locstr (1,comand,string)
  141.           if (locatn .ne. 0) echflg=1
  142.           call modstr (string,2,83)
  143.           locatn=locstr (1,comand,string)
  144.           if (locatn .ne. 0) scrflg=1
  145.       endif
  146. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  147. C                                                                      C
  148. C                     SET INPUT AND OUTPUT FILES                       C
  149. C                                                                      C
  150. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  151.    65 if (ifnflg .eq. 0) then
  152.           WRITE (*,70)
  153.    70     FORMAT (' Input data file name [.INP]? '\)
  154.           READ (*,'(A)') inpfil
  155.       else
  156.           WRITE (*,72) inpfil
  157.    72     FORMAT (' Input data file name [.INP]: ',a78)
  158.       endif
  159.       flspec=inpfil
  160.       call parsfn (flspec,ddrive,ifdriv,idrive,ifpath,ifname,ifextn)
  161.       inpfil=flspec
  162.       if (lenstr(ifextn) .eq. 0) then
  163.           ifextn='.INP '
  164.           call setstr (5,ifextn)
  165.           call constr (inpfil,ifextn)
  166.       endif
  167.       call resstr (inpfil)
  168.       inquire (FILE=inpfil,EXIST=ffound)
  169.       if (ffound) then
  170.           OPEN (1,FILE=inpfil)
  171.       else
  172.           call setstr (78,inpfil)
  173.           call pakstr (inpfil)
  174.           length=lenstr (inpfil)
  175.           call expstr (inpfil)
  176.           call resstr (inpfil)
  177.           call wrfstr (float(length),intgst)
  178.           length=lenstr (intgst)
  179.           prompt='('' ERROR : File "'',a  ,''" cannot be found. Try agai
  180.      +n.'') '
  181.           call setstr (56,prompt)
  182.           call movstr (prompt,21,0,intgst,1,length)
  183.           write (*,prompt) inpfil
  184.           ifnflg=0
  185.           goto 65
  186.       ENDIF
  187.    74 toufil=inpfil
  188.       call setstr (78,toufil)
  189.       locatn=locstr (1,toufil,ifextn)
  190.       call movstr (toufil,locatn,1,toextn,1,4)
  191.       length=lenstr (toufil)
  192.       call expstr (toufil)
  193.       call resstr (toufil)
  194.       call wrfstr (float(length),intgst)
  195.       length=lenstr (intgst)
  196.       prompt='('' Output data file name ['',a  ,'']: '',a78 )
  197.      +  '
  198.       call setstr (56,prompt)
  199.       call movstr (prompt,30,0,intgst,1,length)
  200.       if (ofnflg .eq. 0) then
  201.           call modstr (prompt,35,63)
  202.           string='\    '
  203.           call setstr (5,string)
  204.           call movstr (prompt,38,0,string,1,4)
  205.           call resstr (prompt)
  206.           WRITE (*,prompt) toufil
  207.           READ (*,'(A)') outfil
  208.       else
  209.           call resstr (prompt)
  210.           WRITE (*,prompt) toufil,outfil
  211.       endif
  212.       flspec=outfil
  213.       call parsfn (flspec,idrive-1,ofdriv,odrive,ofpath,ofname,ofextn)
  214.       outfil=flspec
  215.       IF (lenstr(ofdriv) .le. 2) then
  216.           call setstr (78,outfil)
  217.           call endstr (1,outfil)
  218.           if (lenstr(ofdriv) .eq. 0) ofdriv=ifdriv
  219.           if (lenstr(ofpath) .eq. 0) ofpath=ifpath
  220.           if (lenstr(ofname) .eq. 0) ofname=ifname
  221.           if (lenstr(ofextn) .eq. 0) ofextn=toextn
  222.           call constr (outfil,ofdriv)
  223.           call constr (outfil,ofpath)
  224.           call constr (outfil,ofname)
  225.           call constr (outfil,ofextn)
  226.       endif
  227.       call resstr (outfil)
  228.       call opnfil (ierror)
  229.       if (ierror .ne. 0) then
  230.           ofnflg=0
  231.           goto 74
  232.       endif
  233. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  234. C                                                                      C
  235. C                         START THE OUTPUT FILE                        C
  236. C                                                                      C
  237. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  238.       call diskroom (0)
  239. C
  240. C  Header title
  241. C
  242.       call diskroom (331)
  243.       WRITE (2,80,err=2000) datext,timtxt,inpfil,outfil
  244.    80 FORMAT (' M I C R O S A F E --- STRUCTURAL ANALYSIS BY FINITE EL',
  245.      +'EMENTS',4x,'Version: SAFESOLV (2-D)',2x,'Rel. 1.0',3x,a10,1x,a8//
  246.      +/' Input data file  : ',A/' Output data file : ',A/)
  247. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  248. C                                                                      C
  249. C                     START READING THE INPUT FILE                     C
  250. C                                                                      C
  251. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  252.       diamsg='Reading model data from file
  253.      +                                                    '
  254.       call setstr (110,diamsg)
  255.       call setstr (78,inpfil)
  256.       call movstr (diamsg,30,0,inpfil,1,77)
  257.       call resstr (inpfil)
  258.       call pakstr (diamsg)
  259.       call constr (diamsg,elipss)
  260.       call expstr (diamsg)
  261.       call resstr (diamsg)
  262.       call resstr (ofdriv)
  263.       if (ofdriv .eq. 'CON:  ') scrflg=-1
  264. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  265. C                                                                      C
  266. C                 READ AND PROCESS THE MODEL SIZE LINES                C
  267. C                                                                      C
  268. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  269. C
  270. C  Size header
  271. C
  272.       if (echflg .eq. 1) then
  273.           if (scrflg .eq. 1) then
  274.               WRITE (*,85)
  275.    85         FORMAT (/' SIZE OF THE STRUCTURE'/)
  276.           else
  277.               if (scrflg .eq. 0) write (*,87) diamsg
  278.    87         format (/1X,A/' Size...'\)
  279.           endif
  280.           call diskroom (30)
  281.           WRITE (2,85,err=2000)
  282.       else
  283.           write (*,87) diamsg
  284.       endif
  285. C
  286. C  Number of nodes and degrees of freedom
  287. C
  288.       CALL verify(1,entry,ierror,maxban,youngm)
  289.       IF (ierror .NE. 0) GOTO 994
  290.       nnodes=entry(1)
  291.       if (echflg .eq. 1) then
  292.           if (scrflg .eq. 1) WRITE (*,90) nnodes
  293.    90     FORMAT (' Number of nodes                         :',I4)
  294.           call diskroom (48)
  295.           WRITE (2,90,err=2000) nnodes
  296.       endif
  297.       DO 92 loop=1,nnodes
  298.       DO 92 indx=1,3
  299.       reafor(indx,loop)=0.
  300.       pstnor(indx,loop)=0.
  301.    92 pstacc(indx,loop)=0.
  302.       numdof=3*nnodes
  303.       DO 94 loop=1,numdof
  304.    94 appldf(loop)=0.
  305.       malhbw=numele/numdof-2
  306.       if (malhbw .gt. numdof) malhbw=numdof
  307.       longj=numdof*(malhbw+2)
  308.       do 96 longi=1,longj
  309.    96 stmtrx(longi)=0.
  310. C
  311. C  Number of types of material
  312. C
  313.       CALL verify(2,entry,ierror,maxban,youngm)
  314.       IF (ierror .NE. 0) GOTO 994
  315.       nmater=entry(1)
  316.       if (echflg .eq. 1) then
  317.           if (scrflg .eq. 1) WRITE (*,98) nmater
  318.    98     FORMAT (' Number of materials                     :',I4)
  319.           call diskroom (48)
  320.           WRITE (2,98,err=2000) nmater
  321.       endif
  322. C
  323. C  Number of beams
  324. C
  325.       CALL verify(3,entry,ierror,maxban,youngm)
  326.       IF (ierror .NE. 0) GOTO 994
  327.       nbeams=entry(1)
  328.       if (echflg .eq. 1) then
  329.           if (scrflg .eq. 1) WRITE (*,100) nbeams
  330.   100     FORMAT (' Number of beams                         :',I4)
  331.           call diskroom (48)
  332.           WRITE (2,100,err=2000) nbeams
  333.       endif
  334. C
  335. C  Number of plates
  336. C
  337.       CALL verify(4,entry,ierror,maxban,youngm)
  338.       IF (ierror .NE. 0) GOTO 994
  339.       nplate=entry(1)
  340.       if (echflg .eq. 1) then
  341.           if (scrflg .eq. 1) WRITE (*,105) nplate
  342.   105     FORMAT (' Number of plates                        :',I4)
  343.           call diskroom (48)
  344.           WRITE (2,105,err=2000) nplate
  345.       endif
  346.       DO 107 loop=1,nplate
  347.       DO 107 indx=1,3
  348.   107 plstrs(indx,loop)=0.
  349. C
  350. C  Number of fasteners
  351. C
  352.       CALL verify(5,entry,ierror,maxban,youngm)
  353.       IF (ierror .NE. 0) GOTO 994
  354.       nfastn=entry(1)
  355.       if (echflg .eq. 1) then
  356.           if (scrflg .eq. 1) WRITE (*,110) nfastn
  357.   110     FORMAT (' Number of fasteners                     :',I4)
  358.           call diskroom (48)
  359.           WRITE (2,110,err=2000) nfastn
  360.       endif
  361. C
  362. C  Number of loaded nodes
  363. C
  364.       CALL verify(6,entry,ierror,maxban,youngm)
  365.       IF (ierror .NE. 0) GOTO 994
  366.       nlnods=entry(1)
  367.       if (echflg .eq. 1) then
  368.           if (scrflg .eq. 1) WRITE (*,115) nlnods
  369.   115     FORMAT (' Number of loaded nodes                  :',I4)
  370.           call diskroom (48)
  371.           WRITE (2,115,err=2000) nlnods
  372.       endif
  373. C
  374. C  Number of restrained degrees of freedom
  375. C
  376.       CALL verify(7,entry,ierror,maxban,youngm)
  377.       IF (ierror .NE. 0) GOTO 994
  378.       nresdf=entry(1)
  379.       if (echflg .eq. 1) then
  380.           if (scrflg .eq. 1) WRITE (*,120) nresdf
  381.   120     FORMAT (' Number of restrained degrees of freedom :',I4)
  382.           call diskroom (48)
  383.           WRITE (2,120,err=2000) nresdf
  384.       endif
  385. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  386. C                                                                      C
  387. C              READ AND PROCESS THE NODE COORDINATES LINES             C
  388. C                                                                      C
  389. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  390. C
  391. C  Coordinates of the nodes
  392. C
  393.       if (echflg .eq. 1) then
  394.           if (scrflg .eq. 1) then
  395.               WRITE (*,125)
  396.   125         FORMAT (//' NODE COORDINATES'//' Node   Coordinate X   ',
  397.      +                'Coordinate Y'/)
  398.           else
  399.               if (scrflg .eq. 0) write (*,130)
  400.   130         format ('Nodes...'\)
  401.           endif
  402.           call diskroom (68)
  403.           WRITE (2,125,err=2000)
  404.       else
  405.           write (*,130)
  406.       endif
  407.       call chkdup (0,ierror)
  408.       DO 160 loop=1,nnodes
  409.       CALL verify(8,entry,ierror,maxban,youngm)
  410.       IF (ierror .NE. 0) GOTO 994
  411.       i=entry(1)
  412.       coonod(1,i)=entry(2)
  413.       coonod(2,i)=entry(3)
  414.       if (echflg .eq. 1) then
  415.           if (scrflg .eq. 1) WRITE (*,150) i,entry(2),entry(3)
  416.   150     FORMAT (I5,3X,F12.5,3X,F12.5)
  417.           call diskroom (37)
  418.           WRITE (2,150,err=2000) i,entry(2),entry(3)
  419.       endif
  420.   160 CONTINUE
  421. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  422. C                                                                      C
  423. C             READ AND PROCESS THE MATERIAL PROPERTIES LINES           C
  424. C                                                                      C
  425. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  426. C
  427. C  Material properties
  428. C
  429.       if (nmater .gt. 0) then
  430.           if (echflg .eq. 1) then
  431.               if (scrflg .eq. 1) then
  432.                   write (*,170)
  433.   170             FORMAT (//' MATERIAL PROPERTIES'//' Code    Young',
  434.      +                    1H','s modulus','   Poisson',1H','s ratio'/)
  435.               else
  436.                   if (scrflg .eq. 0) write (*,175)
  437.   175             format ('Materials...'\)
  438.               endif
  439.               call diskroom (78)
  440.               WRITE (2,170,err=2000)
  441.           else
  442.               write (*,175)
  443.           endif
  444.           call chkdup (0,ierror)
  445.           DO 190 loop=1,nmater
  446.           CALL verify(9,entry,ierror,maxban,youngm)
  447.           IF (ierror .NE. 0) GOTO 994
  448.           i=entry(1)
  449.           youngm(i)=entry(2)
  450.           poisson(i)=entry(3)
  451.           if (echflg .eq. 1) then
  452.               if (scrflg .eq. 1) WRITE (*,180) i,entry(2),entry(3)
  453.   180         FORMAT (I5,5X,F11.0,8X,F8.5)
  454.               call diskroom (39)
  455.               WRITE (2,180,err=2000) i,entry(2),entry(3)
  456.           endif
  457.   190     CONTINUE
  458.       endif
  459. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  460. C                                                                      C
  461. C                    READ AND PROCESS THE BEAM LINES                   C
  462. C                                                                      C
  463. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  464. C
  465. C  Beams
  466. C
  467.       IF (nbeams .gt. 0) then
  468.           if (echflg .eq. 1) then
  469.               if (scrflg .eq. 1) then
  470.                   write (*,200)
  471.   200             FORMAT (//' BEAM DATA'//' Beam     I     J      ',
  472.      +                    'Length      Area    M. Inertia',
  473.      +                    '   Material       Distributed Loads'/)
  474.               else
  475.                   if (scrflg .eq. 0) write (*,205)
  476.   205             format ('Beams...'\)
  477.               endif
  478.               call diskroom (114)
  479.               WRITE (2,200,err=2000)
  480.           else
  481.               write (*,205)
  482.           endif
  483.           call chkdup (0,ierror)
  484.           DO 220,loop=1,nbeams
  485.           CALL verify(10,entry,ierror,maxban,youngm)
  486.           IF (ierror .NE. 0) GOTO 994
  487.           i=entry(1)
  488.           n1=entry(2)
  489.           n2=entry(3)
  490.           mat=entry(6)
  491.           bmarea(i)=entry(4)
  492.           matcbm(i)=mat
  493.           eyoung=youngm(mat)
  494.           if ((entry(4) .ne. 0.) .and. (eyoung .ne. 0.)) then
  495.               nodebm(1,i)=n1
  496.               nodebm(2,i)=n2
  497.               bminer(i)=entry(5)
  498.               bmdis1(i)=entry(7)
  499.               bmdis2(i)=entry(8)
  500.               mxndif(n1)=MAX(n1,n2,mxndif(n1))
  501.               mxndif(n2)=MAX(n1,n2,mxndif(n2))
  502.           endif
  503.           diffnc(1,2)=coonod(1,n2)-coonod(1,n1)
  504.           diffnc(2,2)=coonod(2,n2)-coonod(2,n1)
  505.           blngth=DSQRT(diffnc(1,2)*diffnc(1,2)+diffnc(2,2)*diffnc(2,2))
  506.           if (echflg .eq. 1) then
  507.               if (scrflg .eq. 1) WRITE (*,210) i,n1,n2,blngth,entry(4),
  508.      +                           entry(5),mat,entry(7),entry(8)
  509.   210         FORMAT (I5,2I6,F12.3,F10.4,F14.5,5X,I3,5X,2F12.3)
  510.               call diskroom (92)
  511.               WRITE (2,210,err=2000) i,n1,n2,blngth,entry(4),entry(5),
  512.      +                               mat,entry(7),entry(8)
  513.           endif
  514.           if ((entry(4) .ne. 0.) .and. (eyoung .ne. 0.)) then
  515.               bmlcos=diffnc(1,2)/blngth
  516.               bmlsin=diffnc(2,2)/blngth
  517.               IF (entry(5) .NE. 0.) THEN
  518.                   nodst3(n1)=1
  519.                   nodst3(n2)=1
  520.               ENDIF
  521.               I3=3*n1
  522.               I2=I3-1
  523.               I1=I2-1
  524.               J3=3*n2
  525.               J2=J3-1
  526.               J1=J2-1
  527.               IF ((entry(7) .NE. 0.) .OR. (entry(8) .NE. 0.)) THEN
  528.                   ftcons(1)=entry(7)*blngth/6
  529.                   ftcons(2)=entry(8)*blngth/6
  530.                   ftcons(3)=ftcons(1)*blngth/30
  531.                   ftcons(4)=ftcons(2)*blngth/30
  532.                   appldf(I1)=appldf(I1)-bmlsin*(2*ftcons(1)+ftcons(2))
  533.                   appldf(I2)=appldf(I2)+bmlcos*(2*ftcons(1)+ftcons(2))
  534.                   appldf(I3)=appldf(I3)+8*ftcons(3)+7*ftcons(4)
  535.                   appldf(j1)=appldf(j1)-bmlsin*(ftcons(1)+2*ftcons(2))
  536.                   appldf(j2)=appldf(j2)+bmlcos*(ftcons(1)+2*ftcons(2))
  537.                   appldf(j3)=appldf(j3)-7*ftcons(3)-8*ftcons(4)
  538.               ENDIF
  539.               ftcons(1)=2*eyoung*entry(5)/blngth
  540.               ftcons(2)=entry(4)*eyoung/blngth
  541.               ftcons(3)=bmlsin/blngth
  542.               ftcons(4)=bmlcos/blngth
  543.               ftcons(5)=6*ftcons(1)*ftcons(3)*ftcons(3)+
  544.      +                  bmlcos*bmlcos*ftcons(2)
  545.               ftcons(6)=6*ftcons(1)*ftcons(3)*ftcons(4)-
  546.      +                  bmlcos*bmlsin*ftcons(2)
  547.               ftcons(7)=6*ftcons(1)*ftcons(4)*ftcons(4)+
  548.      +                  bmlsin*bmlsin*ftcons(2)
  549.               ftcons(8)=-3*ftcons(1)*ftcons(3)
  550.               ftcons(9)=-3*ftcons(1)*ftcons(4)
  551.               CALL assemble (I1,I1,ftcons(5),-ftcons(6),ftcons(8))
  552.               CALL assemble (I1,j1,-ftcons(5),ftcons(6),ftcons(8))
  553.               CALL assemble (I2,I2,ftcons(7),-ftcons(9),0.)
  554.               CALL assemble (I2,j1,ftcons(6),-ftcons(7),-ftcons(9))
  555.               CALL assemble (I3,I3,ftcons(1)*2,0.,0.)
  556.               CALL assemble (I3,j1,-ftcons(8),ftcons(9),ftcons(1))
  557.               CALL assemble (j1,j1,ftcons(5),-ftcons(6),-ftcons(8))
  558.               CALL assemble (j2,j2,ftcons(7),ftcons(9),0.)
  559.               CALL assemble (j3,j3,ftcons(1)*2,0.,0.)
  560.           else
  561.               if (scrflg .ge. 0) write (*,215) i
  562.   215         FORMAT (/' WARNING : The beam',I4,
  563.      +        ' has been disconnected from the model.'/)
  564.               call diskroom (69)
  565.               WRITE (2,215,err=2000) i
  566.               if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
  567.   217         format (' '\)
  568.           endif
  569.   220     CONTINUE
  570.       endif
  571. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  572. C                                                                      C
  573. C                    READ AND PROCESS THE PLATE LINES                  C
  574. C                                                                      C
  575. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  576. C
  577. C  Plates
  578. C
  579.       IF (nplate .gt. 0) then
  580.           if (echflg .eq. 1) then
  581.               if (scrflg .eq. 1) then
  582.                   write (*,240)
  583.   240             FORMAT (//' PLATE DATA'//' Plate    I     J     K',
  584.      +                    '     L   Thickness  Material'/)
  585.               else
  586.                   if (scrflg .eq. 0) write (*,245)
  587.   245             format ('Plates...'\)
  588.               endif
  589.               call diskroom (78)
  590.               WRITE (2,240,err=2000)
  591.           else
  592.               write (*,245)
  593.           endif
  594.           call chkdup (0,ierror)
  595.           DO 360,loop=1,nplate
  596.           CALL verify(11,entry,ierror,maxban,youngm)
  597.           IF (ierror .NE. 0) GOTO 994
  598.           i=entry(1)
  599.           n1=entry(2)
  600.           n2=entry(3)
  601.           n3=entry(4)
  602.           n4=entry(5)
  603.           pthick=entry(6)
  604.           mat=entry(7)
  605.           if (echflg .eq. 1) then
  606.               if (scrflg .eq. 1) WRITE (*,250) i,N1,n2,N3,N4,pthick,mat
  607.   250         FORMAT (I5,4I6,F11.5,5X,I3)
  608.               call diskroom (50)
  609.               WRITE (2,250,err=2000) i,N1,n2,N3,N4,pthick,mat
  610.           endif
  611.           plteth(i)=entry(6)
  612.           matcpl(i)=mat
  613.           eyoung=youngm(mat)
  614.           if ((pthick .ne. 0.) .and. (eyoung .ne. 0.)) then
  615.               pratio=poisson(mat)
  616.               indx=MAX(n1,n2,n3,n4)
  617.               mxndif(n1)=MAX(mxndif(N1),indx)
  618.               mxndif(n2)=MAX(mxndif(N2),indx)
  619.               mxndif(n3)=MAX(mxndif(N3),indx)
  620.               IF (n4 .GT. 0) mxndif(N4)=MAX(mxndif(N4),indx)
  621.               diffnc(1,2)=coonod(1,N2)-coonod(1,N1)
  622.               diffnc(2,2)=coonod(2,N2)-coonod(2,N1)
  623.               diffnc(1,3)=coonod(1,N3)-coonod(1,N2)
  624.               diffnc(2,3)=coonod(2,N3)-coonod(2,N2)
  625.               IF (N4 .EQ. 0) THEN
  626.                   diffnc(1,1)=coonod(1,N1)-coonod(1,N3)
  627.                   diffnc(2,1)=coonod(2,N1)-coonod(2,N3)
  628.               ELSE
  629.                   diffnc(1,4)=coonod(1,N4)-coonod(1,N3)
  630.                   diffnc(2,4)=coonod(2,N4)-coonod(2,N3)
  631.                   diffnc(1,1)=coonod(1,N1)-coonod(1,N4)
  632.                   diffnc(2,1)=coonod(2,N1)-coonod(2,N4)
  633.               ENDIF
  634.               INDX=1
  635.               IF (diffnc(1,2)*diffnc(2,3) .GT. diffnc(2,2)*diffnc(1,3))
  636.      +            INDX=INDX+4
  637.               IF (N4 .EQ. 0) THEN
  638.                   IF (INDX .EQ. 1) THEN
  639.                       n=n2
  640.                       n2=n3
  641.                       n3=n
  642.                   ENDIF
  643.               ELSE
  644.                   IF (diffnc(1,3)*diffnc(2,4) .GT.
  645.      +                diffnc(2,3)*diffnc(1,4)) INDX=INDX+2
  646.                   IF (diffnc(1,4)*diffnc(2,1) .GT.
  647.      +                diffnc(2,4)*diffnc(1,1)) INDX=INDX+1
  648.                   GOTO (260,270,280,300,310,280,300,320) indx
  649.   260                 n=n2
  650.                       n2=n4
  651.                       n4=n
  652.                       GOTO 320
  653.   270                 n=n2
  654.                       n2=n3
  655.                       n3=n
  656.                       GOTO 320
  657.   280                 WRITE (*,290) i
  658.   290                 FORMAT (' ERROR : ILLEGAL NODE DECLARATION FOR ',
  659.      +                        'PLATE',I4,'.')
  660.                       call diskroom (50)
  661.                       WRITE (2,290,err=2000) i
  662.                       goto 994
  663.   300                 n=n2
  664.                       n2=n3
  665.                       n3=n4
  666.                       n4=n
  667.                       GOTO 320
  668.   310                 n=n3
  669.                       n3=n4
  670.                       n4=n
  671.   320             CONTINUE
  672.               ENDIF
  673.               nodepl(1,i)=N1
  674.               nodepl(2,i)=N2
  675.               nodepl(3,i)=N3
  676.               nodepl(4,i)=N4
  677.               IF (N4 .EQ. 0) THEN
  678.                   CALL triasemb (N1,N2,N3,pthick,eyoung,pratio)
  679.               ELSE
  680.                   coonod(1,nnodes+1)=(coonod(1,N1)+coonod(1,N2)+
  681.      +                                coonod(1,N3)+coonod(1,N4))/4
  682.                   coonod(2,nnodes+1)=(coonod(2,N1)+coonod(2,N2)+
  683.      +                                coonod(2,N3)+coonod(2,N4))/4
  684.                   CALL triasemb (N1,N2,nnodes+1,pthick,eyoung,pratio)
  685.                   CALL triasemb (N2,N3,nnodes+1,pthick,eyoung,pratio)
  686.                   CALL triasemb (N3,N4,nnodes+1,pthick,eyoung,pratio)
  687.                   CALL triasemb (N4,N1,nnodes+1,pthick,eyoung,pratio)
  688.                   ftcons(1)=stmqcn(1,1)*stmqcn(2,2)-
  689.      +                      stmqcn(1,2)*stmqcn(2,1)
  690.                   invqcn(1,1)=stmqcn(2,2)/ftcons(1)
  691.                   invqcn(2,2)=stmqcn(1,1)/ftcons(1)
  692.                   invqcn(1,2)=-stmqcn(1,2)/ftcons(1)
  693.                   invqcn(2,1)=invqcn(1,2)
  694.                   DO 330 NI=1,4
  695.                   DO 330 MI=1,2
  696.                   n=(nodepl(NI,i)-1)*3+MI
  697.                   DO 330 NJ=NI,4
  698.                   IF (NJ .EQ. NI) THEN
  699.                       MK=MI
  700.                   ELSE
  701.                       MK=1
  702.                   ENDIF
  703.                   DO 330 mj=MK,2
  704.                   J=(nodepl(NJ,i)-1)*3+MJ
  705.                   k=min(n,j)
  706.                   l=max(n,j)-k+1
  707.                   longk=(malhbw+2)*(k-1)+l
  708.                   do 332 m=1,2
  709.                   longi=(malhbw+2)*(n-1)+malhbw+m
  710.                   ftcons(2)=0.
  711.                   do 331 mm=1,2
  712.                   longj=(malhbw+2)*(j-1)+malhbw+mm
  713.   331             ftcons(2)=ftcons(2)+stmtrx(longj)*invqcn(m,mm)
  714.   332             stmtrx(longk)=stmtrx(longk)-ftcons(2)*stmtrx(longi)
  715.   330             CONTINUE
  716.                   DO 350 NI=1,2
  717.                   DO 340 M=1,4
  718.                   DO 340 MI=1,2
  719.                   longi=(malhbw+2)*((nodepl(M,i)-1)*3+MI)+ni-2
  720.                   stmtrx(longi)=0.
  721.   340             CONTINUE
  722.                   DO 345 MI=1,2
  723.   345             stmqcn(mi,ni)=0.
  724.   350             CONTINUE
  725.               ENDIF
  726.           else
  727.               if (scrflg .ge. 0) write (*,355) i
  728.   355         FORMAT (/' WARNING : The plate',I4,
  729.      +        ' has been disconnected from the model.'/)
  730.               call diskroom (70)
  731.               WRITE (2,355,err=2000) i
  732.               if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
  733.           endif
  734.   360     CONTINUE
  735.       endif
  736. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  737. C                                                                      C
  738. C                  READ AND PROCESS THE FASTENER LINES                 C
  739. C                                                                      C
  740. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  741. C
  742. C  Fasteners
  743. C
  744.       IF (nfastn .gt. 0) then
  745.           if (echflg .eq. 1) then
  746.               if (scrflg .eq. 1) then
  747.                   WRITE (*,380)
  748.   380             FORMAT (//' FASTENER DATA'//
  749.      +                    ' Fastener I     J      Area    Stiffness'/)
  750.               else
  751.                   if (scrflg .eq. 0) write (*,385)
  752.   385             format ('Fasteners...'\)
  753.               endif
  754.               call diskroom (70)
  755.               WRITE (2,380,err=2000)
  756.           else
  757.               write (*,385)
  758.           endif
  759.           call chkdup (0,ierror)
  760.           DO 400 loop=1,nfastn
  761.           CALL verify(12,entry,ierror,maxban,youngm)
  762.           IF (ierror .NE. 0) GOTO 994
  763.           i=entry(1)
  764.           n1=entry(2)
  765.           n2=entry(3)
  766.           if (echflg .eq. 1) then
  767.               if (scrflg .eq. 1) WRITE (*,390) i,n1,n2,entry(4),entry(5)
  768.   390         FORMAT (I5,2I6,F12.6,F11.0)
  769.               call diskroom (42)
  770.               WRITE (2,390,err=2000) i,n1,n2,entry(4),entry(5)
  771.           endif
  772.           fsstif(i)=entry(5)
  773.           if (entry(5) .ne. 0.) then
  774.               ftcons(1)=entry(5)
  775.               nodefs(1,i)=n1
  776.               nodefs(2,i)=n2
  777.               fsarea(i)=entry(4)
  778.               I1=3*n1-2
  779.               I2=I1+1
  780.               J1=3*n2-2
  781.               J2=J1+1
  782.               mxndif(n1)=MAX(n1,n2,mxndif(n1))
  783.               mxndif(n2)=MAX(n1,n2,mxndif(n2))
  784.               CALL assemble (I1,I1,ftcons(1),0.,0.)
  785.               CALL assemble (I1,j1,-ftcons(1),0.,0.)
  786.               CALL assemble (I2,I2,ftcons(1),0.,0.)
  787.               CALL assemble (I2,j2,-ftcons(1),0.,0.)
  788.               CALL assemble (j1,j1,ftcons(1),0.,0.)
  789.               CALL assemble (j2,j2,ftcons(1),0.,0.)
  790.           else
  791.               if (scrflg .ge. 0) write (*,395) i
  792.   395         FORMAT (/' WARNING : The fastener',I4,
  793.      +        ' has been disconnected from the model.'/)
  794.               call diskroom (73)
  795.               WRITE (2,395,err=2000) i
  796.               if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
  797.           endif
  798.   400     CONTINUE
  799.       endif
  800. C
  801. C  Fix unstiffened degrees of freedom
  802. C
  803.       DO 470 loop=1,nnodes
  804.       N1=3*loop-2
  805.       IF (nodst3(loop) .ne. 1) then
  806.           IF (mxndif(loop) .EQ. 0) THEN
  807.               if (scrflg .ge. 0) write (*,465) loop
  808.   465         FORMAT (/' WARNING : The node',I4,
  809.      +        ' is not connected to any element in the model.'/)
  810.               call diskroom (77)
  811.               WRITE (2,465,err=2000) loop
  812.               if ((echflg .eq. 0) .or. (scrflg .eq. 0)) write(*,217)
  813.               igndof(n1)=1
  814.               disdof(n1)=0.
  815.               igndof(n1+1)=1
  816.               disdof(n1+1)=0.
  817.           ENDIF
  818.           igndof(N1+2)=1
  819.           disdof(N1+2)=0.
  820.       endif
  821.   470 CONTINUE
  822. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  823. C                                                                      C
  824. C                 READ AND PROCESS THE NODE LOADS LINES                C
  825. C                                                                      C
  826. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  827. C
  828. C  Node loads
  829. C
  830.       IF (nlnods .gt. 0) then
  831.           if (echflg .eq. 1) then
  832.               if (scrflg .eq. 1) then
  833.                   WRITE (*,410)
  834.   410             FORMAT (//' NODE LOADS'//' Node             PX',
  835.      +                    '            PY            MZ'/)
  836.               else
  837.                   if (scrflg .eq. 0) write (*,415)
  838.   415             format ('Loads...'\)
  839.               endif
  840.               call diskroom (75)
  841.               WRITE (2,410,err=2000)
  842.           else
  843.               write (*,415)
  844.           endif
  845.           call chkdup (0,ierror)
  846.           DO 450 loop=1,nlnods
  847.           CALL verify(13,entry,ierror,maxban,youngm)
  848.           IF (ierror .NE. 0) GOTO 994
  849.           i=entry(1)
  850.           if (echflg .eq. 1) then
  851.               if (scrflg .eq. 1) WRITE (*,440) i,entry(2),entry(3),
  852.      +                                         entry(4)
  853.   440         FORMAT (I5,1X,3F14.2)
  854.               call diskroom (50)
  855.               WRITE (2,440,err=2000) i,entry(2),entry(3),entry(4)
  856.           endif
  857.           N1=3*i-3
  858.           DO 445 j=1,3
  859.           appldf(N1+J)=appldf(N1+J)+entry(j+1)
  860.   445     reafor(J,i)=reafor(J,i)-entry(j+1)
  861.   450     CONTINUE
  862.       endif
  863. C
  864. C  Initialize displacements
  865. C
  866.       DO 460 loop=1,numdof
  867.   460 disdof(loop)=appldf(loop)
  868. C
  869. C  Determine last non-zero element in each row
  870. C
  871.       i=0
  872.       JHB=6
  873.       DO 480 loop=1,nnodes
  874.       J=3*(mxndif(loop)-loop+1)
  875.       IF (J .LT. JHB) THEN
  876.           J=JHB
  877.       ELSE
  878.           JHB=J
  879.       ENDIF
  880.       DO 480 K=1,3
  881.       i=i+1
  882.       lenhbw(i)=min(j,numdof-i+1)
  883.       j=j-1
  884.   480 CONTINUE
  885. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  886. C                                                                      C
  887. C              READ AND PROCESS THE NODE RESTRAINTS LINES              C
  888. C                                                                      C
  889. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  890. C
  891. C  Fixed displacements
  892. C
  893.       IF (nresdf .gt. 0) then
  894.           if (echflg .eq. 1) then
  895.               if (scrflg .eq. 1) then
  896.                   WRITE (*,490)
  897.   490             FORMAT (//' MOVEMENT RESTRAINTS'//' Node           ',
  898.      +                    'Type of restraint         Displacement'/)
  899.               else
  900.                   if (scrflg .eq. 0) write (*,495)
  901.   495             format ('Restraints...'\)
  902.               endif
  903.               call diskroom (90)
  904.               WRITE (2,490,err=2000)
  905.           else
  906.               write (*,495)
  907.           endif
  908.           call chkdup (0,ierror)
  909.           txtdisp(1)='Translation along X axis'
  910.           txtdisp(2)='Translation along Y axis'
  911.           txtdisp(3)=' Rotation about Z axis  '
  912.           DO 510 loop=1,nresdf
  913.           CALL verify(14,entry,ierror,maxban,youngm)
  914.           IF (ierror .NE. 0) GOTO 994
  915.           i=entry(1)
  916.           indxfd=entry(2)
  917.           if (echflg .eq. 1) then
  918.               if (scrflg .eq. 1) WRITE (*,500) i,txtdisp(indxfd),
  919.      +                                         entry(3)
  920.   500         FORMAT (I5,8X,A24,F15.5)
  921.               call diskroom (54)
  922.               WRITE (2,500,err=2000) i,txtdisp(indxfd),entry(3)
  923.           endif
  924.           N1=3*(i-1)+indxfd
  925.           disdof(N1)=entry(3)
  926.           IF (entry(3) .EQ. 0.) THEN
  927.               igndof(N1)=2
  928.           ELSE
  929.               longi=(malhbw+2)*(n1-1)+1
  930.               stmtrx(longi)=1D30
  931.               disdof(N1)=stmtrx(longi)*entry(3)
  932.               igndof(N1)=-2
  933.           ENDIF
  934.   510     CONTINUE
  935.       endif
  936.       CLOSE (1)
  937.       if ((echflg .eq. 0) .or. (scrflg .eq. 0)) WRITE (*,512)
  938.   512 format ('End')
  939. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  940. C                                                                      C
  941. C   SOLVE THE SYSTEM [K]{u}={F} AND REPORT THE RESULTS IN THE SCREEN   C
  942. C                          AND THE OUTPUT FILE                         C
  943. C                                                                      C
  944. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  945.       write (*,522) numdof,maxban
  946.   522 format (/' Solving the system [K]{u}={F}...'/' Number of degrees',
  947.      +         ' of freedom :',i5,'          Bandwidth :'i4//
  948.      +         ' PASS 1 : FORWARD ELIMINATION')
  949.       i1=1+numdof/80
  950.       j1=numdof/i1-2
  951.       k1=78-j1
  952.       dash='-'
  953.       arrow=''
  954.       write (*,524) arrow,(dash,i=1,j1),arrow,(blank,j=1,k1)
  955.   524 format (1x,80a1)
  956. C
  957. C  Calculate displacements
  958. C
  959.       longi=-malhbw-1
  960.       DO 535 I=1,numdof
  961.       if (nextid(i,i1) .eq. 1) call pacer
  962.       longi=longi+malhbw+2
  963.       IF (igndof(I) .le. 0) then
  964.           IF (ABS(stmtrx(longi)) .LT. .000001) THEN
  965.               i1=(i-1)/3+1
  966.               j1=i-3*(i1-1)
  967.               WRITE (*,525) i1,j1
  968.   525         FORMAT (//' ERROR : THE STIFFNESS MATRIX APPEARS TO BE',
  969.      +                ' SINGULAR.'/' The elements connected to node ',i3
  970.      +                ,' do not contribute any stiffness in the free'/
  971.      +                ' degree of freedom ',i1,'.'/)
  972.               call diskroom (162)
  973.               WRITE (2,525,err=2000) i1,j1
  974.               goto 994
  975.           endif
  976.           DO 530 J=1,lenhbw(I)-1
  977.           l=i+j
  978.           IF ((igndof(l) .le. 0) .and. (stmtrx(longi+j) .ne. 0.)) then
  979.               RATIO=stmtrx(longi+j)/stmtrx(longi)
  980.               longl=(malhbw+2)*j+longi-1
  981.               DO 529 k=j+1,lenhbw(I)
  982.               longl=longl+1
  983.               IF (igndof(l) .le. 0) stmtrx(longl)=stmtrx(longl)-
  984.      +                              ratio*stmtrx(longi-1+k)
  985.   529         CONTINUE
  986.               stmtrx(longi+j)=ratio
  987.               disdof(l)=disdof(l)-RATIO*disdof(I)
  988.           endif
  989.   530     CONTINUE
  990.           disdof(i)=disdof(i)/stmtrx(longi)
  991.       ENDIF
  992.   535 CONTINUE
  993.       write (*,536)
  994.   536 format (/' PASS 2 : BACKWARDS SUBSTITUTION')
  995.       write (*,524) arrow,(dash,i=1,j1),arrow,(blank,j=1,k1)
  996.       if (nextid(numdof,i1) .eq. 1) call pacer
  997.       DO 550 i=numdof-1,1,-1
  998.       if (nextid(i,i1) .eq. 1) call pacer
  999.       longj=(malhbw+2)*(i-1)+1
  1000.       IF (igndof(i) .le. 0) then
  1001.           DO 540 K=1,lenhbw(i)-1
  1002.   540     disdof(i)=disdof(i)-stmtrx(longj+k)*disdof(i+k)
  1003.       endif
  1004.   550 CONTINUE
  1005.       write (*,555)
  1006.   555 format (/' The system has been succesfully solved.')
  1007. C
  1008. C  Print displacements
  1009. C
  1010.       if (scrflg .eq. 0) then
  1011.           diamsg='Writing results to file
  1012.      +                                                        '
  1013.           call setstr (110,diamsg)
  1014.           call setstr (78,outfil)
  1015.           call movstr (diamsg,25,1,outfil,1,77)
  1016.           call resstr (outfil)
  1017.           call pakstr (diamsg)
  1018.           call constr (diamsg,elipss)
  1019.           call expstr (diamsg)
  1020.           call resstr (diamsg)
  1021.           write (*,680) diamsg
  1022.   680     format (/1X,A/' Displacements...'\)
  1023.       endif
  1024.       if (scrflg .eq. 1) THEN
  1025.           WRITE (*,685)
  1026.   685     FORMAT (//' NODE DISPLACEMENTS'//
  1027.      +    ' Node         U           V         Omega'/)
  1028.       endif
  1029.       call diskroom (76)
  1030.       WRITE (2,685,err=2000)
  1031.       DO 700 J=1,nnodes
  1032.       if (mxndif(j) .ne. 0) then
  1033.           if (scrflg .eq. 1) WRITE (*,690) j,(disdof(3*(j-1)+i),i=1,3)
  1034.   690     FORMAT (I5,1X,3F12.6)
  1035.           call diskroom (44)
  1036.           WRITE (2,690,err=2000) j,(disdof(3*(j-1)+i),i=1,3)
  1037.       endif
  1038.   700 CONTINUE
  1039. C
  1040. C  Beam corner forces
  1041. C
  1042.       IF (nbeams .gt. 0) then
  1043.           if (scrflg .eq. 1) then
  1044.               WRITE (*,710)
  1045.   710         FORMAT (//' BEAM CORNER FORCES'//
  1046.      +        ' Beam     I     J          FX1         FY1         MZ1',
  1047.      +        '         FX2         FY2         MZ2'/)
  1048.           else
  1049.               if (scrflg .eq. 0) write (*,205)
  1050.           endif
  1051.           call diskroom (125)
  1052.           WRITE (2,710,err=2000)
  1053.           DO 740 i=1,nbeams
  1054.           mat=matcbm(i)
  1055.           eyoung=youngm(mat)
  1056.           if ((eyoung .ne. 0.) .and. (bmarea(i) .ne. 0.)) then
  1057.               n1=nodebm(1,i)
  1058.               n2=nodebm(2,i)
  1059.               diffnc(1,2)=coonod(1,n2)-coonod(1,n1)
  1060.               diffnc(2,2)=coonod(2,n2)-coonod(2,n1)
  1061.               blngth=DSQRT(diffnc(1,2)*diffnc(1,2)+
  1062.      +               diffnc(2,2)*diffnc(2,2))
  1063.               bmlcos=diffnc(1,2)/blngth
  1064.               bmlsin=diffnc(2,2)/blngth
  1065.               I1=3*n1-2
  1066.               j1=3*n2-2
  1067.               ftcons(1)=disdof(J1)-disdof(I1)
  1068.               ftcons(2)=disdof(J1+1)-disdof(I1+1)
  1069.               ftcons(3)=3*(bmlsin*ftcons(1)-bmlcos*ftcons(2))/blngth
  1070.               ftcons(4)=(bmdis1(i)+bmdis2(i))*blngth/2.
  1071.               ftcons(5)=2*eyoung*bminer(i)/blngth
  1072.               ftcons(6)=eyoung*bmarea(i)*(bmlcos*ftcons(1)+
  1073.      +                      bmlsin*ftcons(2))/blngth
  1074.               beamcf(3,1)=ftcons(5)*(ftcons(3)+2*disdof(I1+2)+
  1075.      +                    disdof(J1+2))-(8.*ftcons(4)-bmdis2(i)*
  1076.      +                    blngth/2.)*blngth/90.
  1077.               beamcf(3,2)=ftcons(5)*(2*disdof(J1+2)+disdof(I1+2)+
  1078.      +                    ftcons(3))+(8.*ftcons(4)-bmdis1(i)*
  1079.      +                    blngth/2.)*blngth/90.
  1080.               ftcons(7)=(ftcons(4)+bmdis1(i)*blngth/2.)/3.-
  1081.      +                  (beamcf(3,1)+beamcf(3,2))/blngth
  1082.               ftcons(8)=ftcons(7)-ftcons(4)
  1083.               beamcf(1,1)=-bmlcos*ftcons(6)+bmlsin*ftcons(7)
  1084.               beamcf(1,2)=bmlcos*ftcons(6)-bmlsin*ftcons(8)
  1085.               beamcf(2,1)=-bmlsin*ftcons(6)-bmlcos*ftcons(7)
  1086.               beamcf(2,2)=bmlsin*ftcons(6)+bmlcos*ftcons(8)
  1087.               DO 720 j=1,2
  1088.               DO 720 k=1,3
  1089.               reafor(k,nodebm(j,i))=reafor(k,nodebm(j,i))+beamcf(k,j)
  1090.   720         CONTINUE
  1091.               baxial(i)=ftcons(6)
  1092.               bshear(1,i)=ftcons(7)
  1093.               bshear(2,i)=ftcons(8)
  1094.               bmomnt(1,i)=-beamcf(3,1)
  1095.               bmomnt(2,i)=beamcf(3,2)
  1096.               if (scrflg .eq. 1) WRITE (*,730) i,n1,n2,
  1097.      +                           (beamcf(k,1),k=1,3),(beamcf(k,2),k=1,3)
  1098.   730         FORMAT (I5,2I6,1X,6F12.0)
  1099.               call diskroom (92)
  1100.               WRITE (2,730,err=2000) i,n1,n2,(beamcf(k,1),k=1,3),
  1101.      +                               (beamcf(k,2),k=1,3)
  1102.           endif
  1103.   740     CONTINUE
  1104. C
  1105. C  Beam loads and stresses
  1106. C
  1107.           if (scrflg .eq. 1) WRITE (*,750)
  1108.   750     FORMAT (//' BEAM LOADS AND STRESSES'//
  1109.      +    ' Beam     I     J          PAX         SAX         ',
  1110.      +    'SH1         SH2         BM1         BM2'/)
  1111.           call diskroom (130)
  1112.           WRITE (2,750,err=2000)
  1113.           DO 760 i=1,nbeams
  1114.           mat=matcbm(i)
  1115.           if ((youngm(mat) .ne. 0.) .and. (bmarea(i) .ne. 0.)) then
  1116.               ftcons(1)=baxial(i)/bmarea(i)
  1117.               if (scrflg .eq. 1) WRITE (*,730) i,(nodebm(k,i),k=1,2),
  1118.      +       baxial(i),ftcons(1),(bshear(k,i),k=1,2),(bmomnt(k,i),k=1,2)
  1119.               call diskroom (92)
  1120.               WRITE (2,730,err=2000) i,(nodebm(k,i),k=1,2),baxial(i),
  1121.      +                 ftcons(1),(bshear(k,i),k=1,2),(bmomnt(k,i),k=1,2)
  1122.           endif
  1123.   760     continue
  1124.       endif
  1125. C
  1126. C  Plate corner forces
  1127. C
  1128.       IF (nplate .gt. 0) then
  1129.           if (scrflg .eq. 1) then
  1130.               WRITE (*,770)
  1131.   770         FORMAT (//' PLATE CORNER FORCES'//
  1132.      +        ' Plate    I     J     K     L       FX1      FY1      ',
  1133.      +        'FX2      FY2      FX3      FY3      FX4      FY4'/)
  1134.           else
  1135.               if (scrflg .eq. 0) write (*,245)
  1136.           endif
  1137.           call diskroom (138)
  1138.           WRITE (2,770,err=2000)
  1139.           DO 850 LPL=1,nplate
  1140.           TH=plteth(LPL)
  1141.           mat=matcpl(lpl)
  1142.           eyoung=youngm(mat)
  1143.           pratio=poisson(mat)
  1144.           if ((th .ne. 0.) .and. (eyoung .ne. 0.)) then
  1145.               DO 780 I=1,2
  1146.               DO 780 J=1,4
  1147.   780         pltecf(I,J)=0.
  1148.               IF (nodepl(4,LPL) .EQ. 0) THEN
  1149.                   CALL triloads (1,2,3,th,eyoung,pratio,lpl,nodepl)
  1150.               ELSE
  1151.                   coonod(1,nnodes+1)=(coonod(1,nodepl(1,LPL))+
  1152.      +                  coonod(1,nodepl(2,LPL))+coonod(1,nodepl(3,LPL))+
  1153.      +                  coonod(1,nodepl(4,LPL)))/4
  1154.                   coonod(2,nnodes+1)=(coonod(2,nodepl(1,LPL))+
  1155.      +                  coonod(2,nodepl(2,LPL))+coonod(2,nodepl(3,LPL))+
  1156.      +                  coonod(2,nodepl(4,LPL)))/4
  1157.                   ftcons(7)=0
  1158.                   ftcons(8)=0
  1159.                   ftcons(9)=0
  1160.                   DO 790 i=1,8
  1161.                   DO 790 J=1,2
  1162.   790             sttemp(i,j)=0.
  1163.                   inp(3)=nnodes+1
  1164.                   DO 810 I=1,4
  1165.                   J=nextid(I,4)
  1166.                   inp(1)=nodepl(I,LPL)
  1167.                   inp(2)=nodepl(J,LPL)
  1168.                   DO 800 N1=1,2
  1169.                   DO 800 N2=1,3
  1170.   800             diffnc(N1,N2)=coonod(N1,inp(N2))-
  1171.      +                          coonod(N1,inp(previd(N2,3)))
  1172.                   ftcons(1)=diffnc(2,3)*diffnc(1,2)-
  1173.      +                      diffnc(1,3)*diffnc(2,2)
  1174.                   ftcons(2)=1/(ftcons(1)*(1+pratio))
  1175.                   ftcons(3)=ftcons(2)*(diffnc(1,3)*diffnc(1,2)+
  1176.      +                      diffnc(2,3)*diffnc(2,2))
  1177.                   ftcons(4)=ftcons(2)*(diffnc(2,3)*diffnc(1,2)-
  1178.      +                      diffnc(1,3)*diffnc(2,2))
  1179.                   ftcons(5)=ftcons(2)*(diffnc(1,2)*diffnc(1,2)+
  1180.      +                      diffnc(2,2)*diffnc(2,2))
  1181.                   ftcons(6)=1/(ftcons(1)*(1-pratio))
  1182.                   sttemp(2*i-1,1)=sttemp(2*I-1,1)+ftcons(3)+
  1183.      +                            ftcons(6)*diffnc(2,2)*diffnc(2,3)
  1184.                   sttemp(2*i-1,2)=sttemp(2*I-1,2)+ftcons(4)-
  1185.      +                            ftcons(6)*diffnc(2,3)*diffnc(1,2)
  1186.                   sttemp(2*i,1)=sttemp(2*I,1)-ftcons(4)-
  1187.      +                          ftcons(6)*diffnc(2,2)*diffnc(1,3)
  1188.                   sttemp(2*i,2)=sttemp(2*I,2)+ftcons(3)+
  1189.      +                          ftcons(6)*diffnc(1,3)*diffnc(1,2)
  1190.                   sttemp(2*j-1,1)=sttemp(2*J-1,1)-ftcons(3)-ftcons(5)+
  1191.      +                            ftcons(6)*diffnc(2,2)*diffnc(2,1)
  1192.                   sttemp(2*j-1,2)=sttemp(2*J-1,2)-ftcons(4)-
  1193.      +                            ftcons(6)*diffnc(2,1)*diffnc(1,2)
  1194.                   sttemp(2*J,1)=sttemp(2*J,1)+ftcons(4)-
  1195.      +                          ftcons(6)*diffnc(2,2)*diffnc(1,1)
  1196.                   sttemp(2*J,2)=sttemp(2*J,2)-ftcons(3)-ftcons(5)+
  1197.      +                          ftcons(6)*diffnc(1,1)*diffnc(1,2)
  1198.                   ftcons(7)=ftcons(7)+ftcons(5)+
  1199.      +                      ftcons(6)*diffnc(2,2)*diffnc(2,2)
  1200.                   ftcons(8)=ftcons(8)-
  1201.      +                      ftcons(6)*diffnc(1,2)*diffnc(2,2)
  1202.                   ftcons(9)=ftcons(9)+ftcons(5)+
  1203.      +                      ftcons(6)*diffnc(1,2)*diffnc(1,2)
  1204.   810             CONTINUE
  1205.                   ftcons(1)=0
  1206.                   ftcons(2)=0
  1207.                   DO 820 I=1,4
  1208.                   ftcons(1)=ftcons(1)-
  1209.      +                      sttemp(2*I-1,1)*disdof(3*nodepl(I,LPL)-2)-
  1210.      +                      sttemp(2*I,1)*disdof(3*nodepl(I,LPL)-1)
  1211.                   ftcons(2)=ftcons(2)-
  1212.      +                      sttemp(2*I-1,2)*disdof(3*nodepl(I,LPL)-2)-
  1213.      +                      sttemp(2*I,2)*disdof(3*nodepl(I,LPL)-1)
  1214.   820             CONTINUE
  1215.                   ftcons(3)=ftcons(7)*ftcons(9)-ftcons(8)*ftcons(8)
  1216.                   disdof(numdof+1)=(ftcons(1)*ftcons(9)-
  1217.      +                                ftcons(8)*ftcons(2))/ftcons(3)
  1218.                   disdof(numdof+2)=(ftcons(2)*ftcons(7)-
  1219.      +                                ftcons(8)*ftcons(1))/ftcons(3)
  1220.                   i=-nnodes-1
  1221.                   CALL triloads (1,2,i,th,eyoung,pratio,lpl,nodepl)
  1222.                   CALL triloads (2,3,i,th,eyoung,pratio,lpl,nodepl)
  1223.                   CALL triloads (3,4,i,th,eyoung,pratio,lpl,nodepl)
  1224.                   CALL triloads (4,1,i,th,eyoung,pratio,lpl,nodepl)
  1225.                   DO 830 I=1,3
  1226.   830             plstrs(I,LPL)=plstrs(I,LPL)/4
  1227.               ENDIF
  1228.               if (scrflg .eq. 1) WRITE (*,840) LPL,(nodepl(k,LPL),k=1,4)
  1229.      +                           ,((pltecf(i,j),i=1,2),j=1,4)
  1230.   840         FORMAT (I5,4I6,1X,8F9.0)
  1231.               call diskroom (104)
  1232.               WRITE (2,840,err=2000) LPL,(nodepl(k,LPL),k=1,4),
  1233.      +                               ((pltecf(i,j),i=1,2),j=1,4)
  1234.           endif
  1235.   850     CONTINUE
  1236. C
  1237. C  Plate load-intensities and stresses
  1238. C
  1239.           if (scrflg .eq. 1) WRITE (*,860)
  1240.   860     FORMAT (//' PLATE LOAD INTENSITIES AND STRESSES'//
  1241.      +    ' Plate    I     J     K     L       PIX      PIY      TXY',
  1242.      +    '       SX       SY      TAU     SMAX     SMIN     TMAX',
  1243.      +    '    Angle'/)
  1244.           call diskroom (172)
  1245.           WRITE (2,860,err=2000)
  1246.           DO 890 LPL=1,nplate
  1247.           mat=matcpl(lpl)
  1248.           if ((plteth(lpl) .ne. 0.) .and. (youngm(mat) .ne. 0.)) then
  1249.               DO 870 I=1,3
  1250.   870         plints(I)=plstrs(I,LPL)*plteth(LPL)
  1251.               ftcons(3)=SQRT(plstrs(3,LPL)*plstrs(3,LPL)+
  1252.      +             .25*(plstrs(2,LPL)-plstrs(1,LPL))*(plstrs(2,LPL)-
  1253.      +             plstrs(1,LPL)))
  1254.               ftcons(5)=.5*(plstrs(1,LPL)+plstrs(2,LPL))
  1255.               ftcons(1)=ftcons(5)+ftcons(3)
  1256.               ftcons(2)=ftcons(5)-ftcons(3)
  1257.               ftcons(4)=degree(2*plstrs(3,LPL),
  1258.      +                         plstrs(2,LPL)-plstrs(1,LPL))/2.
  1259.               if (scrflg .eq. 1) WRITE (*,880) LPL,(nodepl(k,LPL),k=1,4)
  1260.      +                          ,(plints(k),k=1,3),(plstrs(k,LPL),k=1,3)
  1261.      +                          ,(ftcons(k),k=1,4)
  1262.   880         FORMAT (I5,4I6,1X,10F9.0)
  1263.               call diskroom (122)
  1264.               WRITE (2,880,err=2000) LPL,(nodepl(k,LPL),k=1,4),
  1265.      +        (plints(k),k=1,3),(plstrs(k,LPL),k=1,3),(ftcons(k),k=1,4)
  1266.           endif
  1267.   890     CONTINUE
  1268. C
  1269. C  Plate stresses at node points
  1270. C
  1271.           if (scrflg .eq. 1) WRITE (*,900)
  1272.   900     FORMAT (//' PLATE STRESSES AT NODE POINTS'//
  1273.      +    ' Node   Coordinate X   Coordinate Y        SX        SY    ',
  1274.      +    '   TAU      SMAX      SMIN      TMAX     Angle'/)
  1275.           call diskroom (151)
  1276.           WRITE (2,900,err=2000)
  1277.           DO 930 I=1,nnodes
  1278.           k=0
  1279.           DO 910 J=1,3
  1280.           IF (pstnor(J,I) .GT. 0.) THEN
  1281.               ftcons(J)=pstacc(J,I)/pstnor(J,I)
  1282.           ELSE
  1283.               k=1
  1284.           ENDIF
  1285.   910     CONTINUE
  1286.           if (k .ne. 1) then
  1287.               ftcons(6)=SQRT(ftcons(3)*ftcons(3)+
  1288.      +        .25*(ftcons(2)-ftcons(1))*(ftcons(2)-ftcons(1)))
  1289.               ftcons(8)=.5*(ftcons(1)+ftcons(2))
  1290.               ftcons(4)=ftcons(8)+ftcons(6)
  1291.               ftcons(5)=ftcons(8)-ftcons(6)
  1292.               ftcons(7)=degree(sngl(2*ftcons(3)),
  1293.      +                         sngl(ftcons(2)-ftcons(1)))/2.
  1294.               if (scrflg .eq. 1) WRITE (*,920) I,coonod(1,I),coonod(2,I)
  1295.      +                           ,(ftcons(k),k=1,7)
  1296.   920         FORMAT (I5,3X,F12.5,3X,F12.5,7F10.0)
  1297.               call diskroom (107)
  1298.               WRITE (2,920,err=2000) I,coonod(1,I),coonod(2,I),
  1299.      +                               (ftcons(k),k=1,7)
  1300.           endif
  1301.   930     CONTINUE
  1302.       endif
  1303. C
  1304. C  Fastener forces and stresses
  1305. C
  1306.       IF (nfastn .gt. 0) then
  1307.           if (scrflg .eq. 1) then
  1308.               WRITE (*,940)
  1309.   940         FORMAT (//' FASTENER FORCES AND STRESSES'//
  1310.      +        ' Fastener I     J         FX        FY         F     ',
  1311.      +        'Angle    Stress'/)
  1312.           else
  1313.               if (scrflg .eq. 0) write (*,385)
  1314.           endif
  1315.           call diskroom (113)
  1316.           WRITE (2,940,err=2000)
  1317.           DO 960 LFS=1,nfastn
  1318.           if (fsstif(lfs) .ne. 0.) then
  1319.               n1=nodefs(1,LFS)
  1320.               n2=nodefs(2,LFS)
  1321.               I1=3*n1-2
  1322.               J1=3*n2-2
  1323.               ftcons(1)=fsstif(lfs)*(disdof(I1)-disdof(J1))
  1324.               ftcons(2)=fsstif(lfs)*(disdof(I1+1)-disdof(J1+1))
  1325.               ftcons(3)=SQRT(ftcons(1)*ftcons(1)+ftcons(2)*ftcons(2))
  1326.               ftcons(4)=degree(sngl(ftcons(2)),sngl(ftcons(1)))
  1327.               ftcons(5)=ftcons(3)/fsarea(lfs)
  1328.               if (scrflg .eq. 1) WRITE (*,950) LFS,n1,n2,
  1329.      +                                         (ftcons(k),k=1,5)
  1330.   950         FORMAT (I5,2I6,1X,5F10.0)
  1331.               call diskroom (70)
  1332.               WRITE (2,950,err=2000) LFS,n1,n2,(ftcons(k),k=1,5)
  1333.               reafor(1,n1)=reafor(1,n1)+ftcons(1)
  1334.               reafor(1,n2)=reafor(1,n2)-ftcons(1)
  1335.               reafor(2,n1)=reafor(2,n1)+ftcons(2)
  1336.               reafor(2,n2)=reafor(2,n2)-ftcons(2)
  1337.           endif
  1338.   960     CONTINUE
  1339.       endif
  1340. C
  1341. C  Node internal forces and reactions
  1342. C
  1343.       reaclb(1)='        '
  1344.       reaclb(2)='        '
  1345.       reaclb(3)='Reaction'
  1346.       if (scrflg .eq. 1) then
  1347.           WRITE (*,970)
  1348.   970     FORMAT (//' NODE INTERNAL FORCES AND REACTIONS'//
  1349.      +    ' Node   Coordinate X   Coordinate Y          FX',
  1350.      +    '                    FY                    MZ'/)
  1351.       else
  1352.           if (scrflg .eq. 0) write (*,972)
  1353.   972     format ('Reactions...'\)
  1354.       endif
  1355.       call diskroom (142)
  1356.       WRITE (2,970,err=2000)
  1357.       DO 990 I=1,nnodes
  1358.       if (scrflg .eq. 1) WRITE (*,980) I,coonod(1,I),coonod(2,I),
  1359.      +             (reafor(j,I),reaclb(1+abs(igndof((i-1)*3+j))),j=1,3)
  1360.   980 FORMAT (I5,3X,F12.5,3X,F12.5,3(F12.0,1x,a8,1x))
  1361.       call diskroom (103)
  1362.       WRITE (2,980,err=2000) I,coonod(1,I),coonod(2,I),
  1363.      +             (reafor(j,I),reaclb(1+abs(igndof((i-1)*3+j))),j=1,3)
  1364.   990 CONTINUE
  1365.       if (scrflg .eq. 0) write (*,512)
  1366. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  1367. C                                                                      C
  1368. C                       REPORT THE EXECUTION TIME                      C
  1369. C                                                                      C
  1370. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  1371. C
  1372. C  Report the execution time
  1373. C
  1374.   994 cpusec=0.
  1375.       call time (lasthr,lastmn,lastsc,lasths)
  1376.       if (lasthr .lt. inithr) cpusec=86400.
  1377.       cpusec=cpusec+3600.*(lasthr-inithr)+60.*(lastmn-initmn)+lastsc-
  1378.      +       initsc+.01*(lasths-iniths)
  1379.       if (scrflg .ge. 0) write (*,995) cpusec
  1380.   995 format (//' Execution time : ',f8.2,' seconds.')
  1381.       if (ierror .ne. -1) then
  1382.           call diskroom (43)
  1383.           write (2,995,err=2000) cpusec
  1384.       endif
  1385.       write (*,999)
  1386.   999 format (' ')
  1387.       STOP
  1388. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  1389. C                                                                      C
  1390. C                REPORT UNSPECIFIED I/O ERRORS DETECTED                C
  1391. C                                                                      C
  1392. CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  1393.  1000 write (*,1010)
  1394.  1010 format (//' ERROR : CANNOT READ INPUT FILE.'/
  1395.      +          ' The program cannot continue.')
  1396.       goto 994
  1397.  2000 write (*,2010)
  1398.  2010 format (//' ERROR : CANNOT WRITE OUTPUT FILE.'/
  1399.      +          ' The program cannot continue.')
  1400.       ierror=-1
  1401.       goto 994
  1402.       END
  1403.